home *** CD-ROM | disk | FTP | other *** search
/ Commodore 64 Scene Diskmags Assortment / Uptime_The_Disk_Monthly_V1_05_19xx_Uptime_staff_Side_A.d64 / data cruncher (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  6KB  |  223 lines
  1. 20 sys 65418
  2. 30 poke 53280,11:poke 53281,0
  3. 40 poke 808,234
  4. 50 poke 55,0:poke 56,95:clr
  5. 60 gosub 910:rem poke ml at 50000
  6. 70 dim k(255)
  7. 75 gosub 4000
  8. 80 print"[147]"spc(5)"[215]hat type of file to compress?"
  9. 82 printspc(14)"[[196]]oodle"
  10. 84 printspc(14)"[[203]]oalapad"
  11. 86 printspc(14)"[[207]]ther"
  12. 90 gosub 2300
  13. 110 print"[194]order [195]olor: (0-15) ";
  14. 112 ch$="n":max=2:gosub 2000
  15. 114 if t$="" then t$="0":print"[145]"spc(21)t$"":goto 120
  16. 116 if val(t$)<0 or val(t$)>15 then print"[145]"spc(21)"  [157][157]";:goto 112
  17. 120 bc=val(t$)
  18. 122 print"[158] --------------------------------------"
  19. 125 print"[198]ile to crunch: ";
  20. 130 max=16:gosub 2000
  21. 135 f$="source file":if t$="" then print"[145]"spc(16)f$
  22. 137 if t$<>"" then f$=t$
  23. 140 print"[196]rive: (8-11) ";
  24. 141 ch$="n":max=2:gosub 2000
  25. 142 if t$="" then t$="8":print"[145]"spc(14)t$"":goto 146
  26. 144 if (val(t$)<8) or (val(t$)>11) then print"[145]"spc(14)"  [157][157]";:goto 141
  27. 146 d1=val(t$)
  28. 148 printspc(10)"[158] -------------------"
  29. 150 print"[206]ew filename: ";
  30. 152 max=16:gosub 2000
  31. 154 nf$="compressed file":if t$="" then print"[145]"spc(14)nf$
  32. 156 if t$<>"" then nf$=t$
  33. 160 print"[196]rive: (8-11) ";
  34. 162 ch$="n":max=2:gosub 2000
  35. 164 if t$="" then t$="8":print"[145]"spc(14)t$"":goto 168
  36. 166 if (val(t$)<8) or (val(t$)>11) then print"[145]"spc(14)"  [157][157]";:goto 162
  37. 168 d2=val(t$)
  38. 170 print"[158] --------------------------------------"
  39. 175 printspc(10)"[201]nsert file disk(s)."
  40. 180 printspc(4)"[210][197][212][213][210][206] when ready. [158][198]8 for [213]p[212]ime.[145][145]"
  41. 190 get t$:if t$="" then 190
  42. 192 if t$=chr$(140) then 1100
  43. 194 if t$<>chr$(13) then 190
  44. 200 printspc(7)"[204]oading and scanning file..."
  45. 205 print"                                      [145][145]"
  46. 210 x=0
  47. 220 kback=34576:rem background for koala
  48. 230 ad=24576:rem load start address
  49. 240 open 15,d1,15,"i0"
  50. 250 open 2,d1,2,"0:"+f$+",p,r"
  51. 260 input#15,en,em$,et,es
  52. 265 if en<>0 then close 15:close 2:gosub 2400:goto 125
  53. 270 sys 50000:rem loads into 24576, finds key
  54. 280 close 2:close15
  55. 290 ea=peek(2025)+256*peek(2026)
  56. 300 ky=peek(2027):v=peek(2028)+peek(2029)*256
  57. 310 print"[147]   [203]ey byte is"ky"  (used"v"times)"
  58. 320 ba=peek(kback)and15:rem only used for koala
  59. 330 open15,d2,15,"i0"
  60. 332 input#15,en,em$,et,es
  61. 334 if en<>0 then close5:close15:gosub 2400:goto 80
  62. 335 print#15,"s0:"+nf$
  63. 340 open 5,d2,5,"0:"+nf$+",p,w"
  64. 350 print#5,chr$(0)chr$(0);:rem dummy address
  65. 360 print#5,chr$(ky);:rem key byte
  66. 370 print#5,ty$;:rem type code
  67. 380 print#5,chr$(ba);:rem background color
  68. 390 print#5,chr$(bc);:rem border color
  69. 395 print"[158] --------------------------------------"
  70. 420 if ty$<>"o" then 500
  71. 430 rem ***** filetype=other ********
  72. 440 rem (not doodle or koala format)
  73. 450 rem one file, no separate screens
  74. 470 a1=ad:e1=ea:gosub 690:close 5:goto 3000
  75. 500 if ty$<>"d" then 590
  76. 510 rem ****** filetype = doodle ******
  77. 520 rem standard hires, 8192 bitmap+color
  78. 540 a1=ad:e1=ad+999:gosub690
  79. 550 a1=ad+1024:e1=ad+9204:gosub690
  80. 560 close 5:goto 3000
  81. 600 rem ****** filetype = koala *******
  82. 610 rem multi hires, 8800 bitmap+colors,background
  83. 630 a1=ad:e1=ad+7999:gosub690:rem bitmap
  84. 640 a1=ad+8000:e1=ad+8999:gosub690:rem color1
  85. 650 a1=ad+9000:e1=ad+9999:gosub690:rem color2
  86. 660 close5:goto 3000
  87. 690 rem crunch
  88. 700 print:printtab(8)"[195]runching"a1"to"e1"
  89. 710 x[178]a1[171]1:rp[178]1
  90. 720 [143] loop
  91. 730 x[178]x[170]1
  92. 740 [139] x[178]e1 [167] [137] 850
  93. 750 ol[178][194](x):ne[178][194](x[170]1)
  94. 760 [139] ol[179][177]ne [167] [141] 780 : [137] 720
  95. 770 rp[178]rp[170]1:[137]720
  96. 780 [143] print to disk
  97. 790 [139] rp[177]255 [167] q[178]rp:rp[178]255:[141]830:rp[178]q[171]255:[137]790
  98. 800 [139] rp[178]1 [167] [152]5,[199](ol);:[137]840
  99. 810 [139] rp[178]2 [167] [152]5,[199](ol);[199](ol);:[137]840
  100. 820 [139] rp[178]3 [167] [152]5,[199](ol);[199](ol);[199](ol);:[137]840
  101. 830 [152]5,[199](ky)[199](ol)[199](rp);
  102. 840 rp[178]1:[142]
  103. 850 [143] add done codes, return
  104. 860 [141] 780
  105. 870 [152]5,[199](ky)[199](0)[199](0);
  106. 880 [142]
  107. 900 [143] machine code
  108. 910 [129]j[178]50000[164]50139:[135]a:[151]j,a:[130]:[142]
  109. 920 [131] 032,207,195,162,002,032,198,255,032,228
  110. 930 [131] 255,032,228,255,169,000,133,251,169,096
  111. 940 [131] 133,252,160,000,032,228,255,145,251,230
  112. 950 [131] 251,208,002,230,252,170,254,000,157,240
  113. 960 [131] 003,076,127,195,254,000,158,165,144,240
  114. 970 [131] 229,032,204,255,165,251,141,233,007,165
  115. 980 [131] 252,141,234,007,169,000,133,180,133,181
  116. 990 [131] 133,190,032,182,195,165,190,208,009,230
  117. 1000 [131] 180,208,002,230,181,076,152,195,142,235
  118. 1010 [131] 007,165,180,141,236,007,165,181,141,237
  119. 1020 [131] 007,096,162,000,189,000,157,197,180,208
  120. 1030 [131] 012,189,000,158,197,181,208,005,169,001
  121. 1040 [131] 133,190,096,202,208,234,096,162,000,138
  122. 1050 [131] 157,000,157,157,000,158,202,208,247,096
  123. 1100 [159] 15,8,15,"i0"
  124. 1110 [159] 2,8,2,"0:upt.reboot,p,r"
  125. 1120 [132]15,er$
  126. 1130 [160] 2:[160] 15
  127. 1140 [139] er$[179][177]"00" [167] 1200
  128. 1145 [153]"load"[166]10)"sys(NULL)ne moment please...":[153][166]12)"(NULL)eloading (NULL)p(NULL)ime."
  129. 1150 [147]"0:upt.reboot",8
  130. 1200 [153]"load  right$nsert (NULL)p(NULL)ime disk and press (NULL)val(NULL)(NULL)(NULL)(NULL)"
  131. 1210 [161] a$:[139] a$[179][177][199](13) [167] 1210
  132. 1220 [137] 1100
  133. 1995 :
  134. 1996 [143] *******************
  135. 1997 [143]  kbd input routine
  136. 1998 [143] *******************
  137. 2000 ct[178]0:t$[178]"":cs$[178]"tocmd":[153]cs$;
  138. 2010 [151] 198,0
  139. 2020 [161] k$:[139] k$[178]"" [167] 2020
  140. 2027 [139] k$[178]"restore" [167] 1100
  141. 2030 [139] k$[178][199](13) [167] 2190
  142. 2040 [139] k$[179][177][199](20) [167] 2100
  143. 2050 [139] ct[178]0 [167] 2020
  144. 2060 ct[178]ct[171]1:t$[178][200](t$,ct)
  145. 2070 [153]" cmdcmd cmd"cs$;
  146. 2080 [137] 2020
  147. 2100 [139] ct[178]max [167] 2020
  148. 2102 [139] ch$[178]"a" [167] [137] 2110
  149. 2104 [139] (k$[179][199](48)) [176] k$[177][199](57) [167] 2020
  150. 2106 [137] 2150
  151. 2110 [139] k$[179][199](32) [167] 2020
  152. 2120 [139] k$[178][199](34) [167] 2020
  153. 2130 [139] k$[177][199](95) [175] k$[179][199](193) [167] 2020
  154. 2140 [139] k$[177][199](218) [167] 2020
  155. 2150 ct[178]ct[170]1:t$[178]t$[170]k$:[153]k$;
  156. 2160 [139] ct[179][177]max [167] [153]cs$;
  157. 2170 [137] 2020
  158. 2190 [153]" ":ch$[178]"a"
  159. 2200 [142]
  160. 2295 :
  161. 2296 [143] *****************
  162. 2297 [143]  file type input
  163. 2298 [143] *****************
  164. 2300 cx[178]5:cy[178]5:cz[178]5
  165. 2305 [161] ty$:[139] ty$[178]"" [167] 2305
  166. 2310 [139] ty$[179][177]"d" [175] ty$[179][177]"o" [175] ty$[179][177]"k" [167] 2305
  167. 2320 [139] ty$[178]"d" [167] cx[178]1
  168. 2330 [139] ty$[178]"k" [167] cy[178]1
  169. 2340 [139] ty$[178]"o" [167] cz[178]1
  170. 2350 [129] t[178]0[164]8
  171. 2355 [139] t[178]1 [167] t[178]2
  172. 2360 [151] 55431[170]t,cx
  173. 2370 [151] 55471[170]t,cy
  174. 2380 [151] 55511[170]t,cz
  175. 2390 [130]:[142]
  176. 2395 :
  177. 2396 [143] ********************
  178. 2397 [143]  disk error routine
  179. 2398 [143] ********************
  180. 2399 :
  181. 2400 em$[178]"ascile not ascound"
  182. 2410 [139] en[179][177]62 [167] em$[178]"str$isk valrror valncountered"
  183. 2420 sz[178][181]((40[171]([195](em$)[170]12))[173]2)
  184. 2430 [153][166]sz)"-> -> def"em$" <- <-  "
  185. 2440 [153][166]7)"(NULL)ress (NULL)pacebar to lenontinueon"
  186. 2450 [161] k$: [139] k$[179][177][199](32) [167] 2450
  187. 2460 [153]""
  188. 2470 [129] t[178]1[164]13
  189. 2475 [153]"                                       "
  190. 2480 [130]
  191. 2485 [153]"                                       "
  192. 2490 [142]
  193. 3000 [153]"sys -------------------------------------
  194. 3005 printtab(10)"[198]inished [195]ompacting!
  195. 3010 [153]"  (NULL)ress (NULL)val(NULL)(NULL)(NULL)(NULL) to compact another file
  196. 3015 printtab(12)"[164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  197. 3020 printtab(12)" [198]8 for [213]p[212]ime "
  198. 3030 get a$:if a$="" then 3030
  199. 3040 if a$=chr$(13) then 80
  200. 3050 if a$<>"[140]" then 3030
  201. 3060 goto 1100
  202. 4000 print"[147]"tab(8)"[158][200]i[210]es [208]icture [195]runcher!"
  203. 4010 print" (make little files out of [194][201][199] files!)
  204. 4020 [153][163]9)"(c) 1987 peekruce mid$aegar"
  205. 4100 [153][163]8)"defortantantantantantantantantantantantantantantantan^
  206. 4110 printtab(8)"[221]                [221]
  207. 4120 [153][163]8)"(NULL)                (NULL)
  208. 4130 printtab(8)"[221]                [221]
  209. 4140 [153][163]8)"(NULL)                (NULL)
  210. 4150 printtab(8)"[221]                [221]
  211. 4160 [153][163]8)"(NULL)           ortantantantan>tantantantan^
  212. 4170 printtab(8)"[221]           [221]         [221]
  213. 4180 [153][163]8)"(NULL)           (NULL)         (NULL)
  214. 4190 printtab(8)"[221]           [221]         [221]
  215. 4200 [153][163]8)"(NULL)           (NULL)         (NULL)
  216. 4210 printtab(8)"[173][192][192][192][192][192][192][192][192][192][192][192][179]         [221]
  217. 4220 [153][163]8)"            (NULL)         (NULL)
  218. 4230 printtab(8)"            [173][192][192][192][192][192][192][192][192][192][189]
  219. 4300 [153]" (NULL)ublished by (NULL)iking (NULL)echnologies, right$nc."
  220. 4310 [153][163]8)"(NULL)ress (NULL)val(NULL)(NULL)(NULL)(NULL) to lenontinue"
  221. 4320 [161] a$:[139] a$[179][177][199](13) [167] 4320
  222. 4330 [142]
  223.